home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Atari Forever 4
/
Atari Forever 4.zip
/
Atari Forever 4.iso
/
SERIE_AI
/
AI_064
/
AI_064.ZIP
/
C64
/
C64_DEMO.PGS
/
EMULATOR.MOD
< prev
Wrap
Text File
|
1988-09-01
|
11KB
|
429 lines
MODULE Emulator;
FROM TextIO IMPORT WriteCard,WriteString,REadString,
WriteInt,WriteLn;
FROM Terminal IMPORT BusyRead,Read,Write;
FROM MyTools1 IMPORT Input,Cls,Wait,Wrap,Crsat,Cursor,Reverse,WESC;
FROM SYSTEM IMPORT CODE,BYTE,WORD,LONGWORD,ADDRESS,ADR;
FROM String IMPORT InitStringModule,Pos,Concat,Copy,Strings,
Length,GetTerminator,Compare,
Delete,CompareResults;
FROM M2Conversions IMPORT ConvertCardinal;
FROM ASCII IMPORT CharIsPrintable,DEL;
FROM GEMDOS IMPORT RawScanIn,SFirst,SetDTA;
FROM Streams IMPORT Stream,StreamKinds,OpenStream,CloseStream,
EOS;
CONST Cup = 110C;
Cdn = 120C;
Clf = 113C;
Crt = 115C;
Ins = 122C;
Hme = 107C;
Hlp = 142C;
Und = 141C;
Hmx64 = 20;
Hmy64 = 0;
Spaces40 = " ";
LastBasicLine = 500;
TYPE Strngs = ARRAY[0..39] OF CHAR;
Screen64 = ARRAY[0..24] OF Strngs;
Charset = SET OF CHAR;
BasicLine = ARRAY[0..38] OF CHAR;
DmaBuf = RECORD
Buf : ARRAY [0..21] OF BYTE;
Time : WORD;
Date : WORD;
Size : LONGWORD;
Name : ARRAY [0..13] OF CHAR;
Drive : WORD;
AuxBuf : ARRAY [0..15] OF BYTE;
END;
VAR MyBuf : DmaBuf;
d1541 : Stream;
Scr : Screen64;
Cx,Cy : CARDINAL;
S,C : CHAR;
Mem : ARRAY[0..LastBasicLine] OF BasicLine;
CmdLine : BasicLine;
RevFlag : CARDINAL;
EMUL520 : BOOLEAN;
PROCEDURE OutScr64;
VAR i : CARDINAL;
BEGIN
Cursor(0);
FOR i := 0 TO 24 DO
Crsat(Hmy64+i,Hmx64); WriteString(Scr[i]);
END;
Crsat(Hmy64+Cy,Hmx64+Cx);
Cursor(1);
END OutScr64;
PROCEDURE Clr64;
VAR i:CARDINAL;
BEGIN
Cx := 0; Cy := 0;
FOR i := 0 TO 24 DO Scr[i]:=Spaces40; END;
OutScr64;
Crsat(Hmy64,Hmx64);
END Clr64;
PROCEDURE UpdLine;
VAR i:CARDINAL;
BEGIN
Cursor(0);
Crsat(Hmy64+Cy,Hmx64);
FOR i:=0 TO 39 DO Write(Scr[Cy][i]); END;
Crsat(Hmy64+Cy,Hmx64+Cx);
Cursor(1);
END UpdLine;
PROCEDURE Print(VAR S:ARRAY OF CHAR);
VAR l,i : CARDINAL;
BEGIN
FOR i := 0 TO Length(S)-1 DO OutChr64(S[i],377C); END;
END Print;
PROCEDURE PrintLn(VAR S:ARRAY OF CHAR);
VAR l,i : CARDINAL;
BEGIN
FOR i := 0 TO Length(S)-1 DO OutChr64(S[i],377C); END;
CR64;
END PrintLn;
PROCEDURE CR64;
BEGIN
RevFlag := 1; Reverse(1);
Cx := 0; Cy := Cy +1;
IF Cy > 24 THEN Cy := 24; Scroll64; END;
Crsat(Hmy64+Cy,Hmx64+Cx);
END CR64;
PROCEDURE Home64;
BEGIN
Cx := 0; Cy := 0;
Crsat(Hmy64+Cy,Hmx64+Cx);
END Home64;
PROCEDURE INS64;
VAR i:CARDINAL;
BEGIN
FOR i := 39 TO Cx+1 BY -1 DO Scr[Cy][i]:=Scr[Cy][i-1]; END;
Scr[Cy][Cx] := " ";
UpdLine;
END INS64;
PROCEDURE DEL64;
VAR i:CARDINAL;
BEGIN
IF Cx > 0 THEN
FOR i := Cx TO 39 DO Scr[Cy][i-1]:=Scr[Cy][i] END;
Scr[Cy][39] := " ";
Cx := Cx - 1;
UpdLine;
END;
Crsat(Hmy64+Cy,Hmx64+Cx);
END DEL64;
PROCEDURE OutChr64(C,S:CHAR);
VAR d : CARDINAL;
BEGIN
IF CharIsPrintable(C) THEN
IF C="|" THEN RevFlag := 1- RevFlag; Reverse(RevFlag);
ELSE
Scr[Cy][Cx] := C;
Crsat(Hmy64+Cy,Hmx64+Cx);
Write(C);
Cx := Cx +1;
IF Cx > 39 THEN CR64; END;
Crsat(Hmy64+Cy,Hmx64+Cx);
END;
ELSE
CASE C OF
15C : CR64 |
DEL : DEL64 |
ELSE
CASE S OF
Cup : IF Cy > 0 THEN Cy := Cy-1;
Crsat(Hmy64+Cy,Hmx64+Cx);
END; |
Cdn : IF Cy < 24 THEN Cy := Cy+1;
Crsat(Hmy64+Cy,Hmx64+Cx);
ELSE
Scroll64;
END; |
Clf : IF Cx > 0 THEN Cx := Cx -1;
ELSE
IF Cy > 0 THEN Cy := Cy-1; Cx := 39; END;
END;
Crsat(Hmy64+Cy,Hmx64+Cx); |
Crt : IF Cx < 39 THEN Cx := Cx+1;
ELSE
Cy := Cy+1; Cx := 0;
IF Cy=25 THEN Cy := 24; Scroll64; END;
END;
Crsat(Hmy64+Cy,Hmx64+Cx); |
Ins : INS64; |
Hme : Home64; |
Und : Clr64;
ELSE ;
END;
END;
END;
END OutChr64;
PROCEDURE Scroll64;
VAR i : CARDINAL;
BEGIN
FOR i := 1 TO 24 DO Scr[i-1] := Scr[i]; END;
Scr[24] := Spaces40;
Cursor(0);
Crsat(24,Hmx64);
Write(12C);
WriteString(Spaces40);
Crsat(Hmy64+Cy,Hmx64+Cx);
Cursor(1);
END Scroll64;
PROCEDURE Reset64;
BEGIN
Cls(1);
Reverse(1);
RevFlag := 1;
Clr64;
BASNEW;
CR64;
PrintLn(" **** Commodore 64 BASIC V2 **** ");
CR64;
PrintLn(" 64 K RAM SYSTEM 38911 BASIC BYTES FREE");
CR64;
PrintLn("READY.");
END Reset64;
PROCEDURE BASNEW;
VAR i : CARDINAL;
BEGIN FOR i:=0 TO LastBasicLine DO Mem[i][0] := GetTerminator(); END;
END BASNEW;
PROCEDURE CutBlanks(VAR Source,T:Strngs);
VAR i,s,e : INTEGER;
Target:Strngs;
BEGIN
s := 0; e := Length(Source)-1;
IF e >= 0 THEN
WHILE (s < 39) AND (Source[s]=" ") DO s := s + 1; END;
WHILE (e >=0) AND (Source[e]=" ") DO e := e - 1; END;
FOR i := s TO e DO Target[i-s] := Source[i]; END;
IF e >= s THEN
Target[e-s+1] := GetTerminator();
ELSE Target[0] := GetTerminator(); END;
END;
T := Target;
END CutBlanks;
PROCEDURE Store(VAR S:Strngs);
(* S MUST start with digit ! *)
VAR P,Line : CARDINAL;
BEGIN
Line := 0; P:=0;
IF S[0] IN Charset {"0".."9"} THEN
WHILE (S[P] IN Charset {"0".."9"}) AND (Line <= LastBasicLine) DO
Line := Line*10+ORD(S[P])-ORD("0");
P := P + 1;
END;
IF Line <= LastBasicLine THEN
Mem[Line] := S;
IF P = Length(S) THEN Mem[Line][0] := GetTerminator(); END;
ELSE
PrintLn("?Out of memory error.");
END;
END;
END Store;
PROCEDURE PBASNEW(VAR Arg : Strngs) : BOOLEAN;
BEGIN
BASNEW;
RETURN(TRUE);
END PBASNEW;
PROCEDURE LIST(VAR Arg : Strngs) : BOOLEAN;
VAR i,from,to : CARDINAL;
flag : BOOLEAN;
BEGIN
Cursor(0);
FOR i := 0 TO LastBasicLine DO
IF Length(Mem[i]) > 0 THEN
PrintLn(Mem[i]);
END;
END;
Cursor(1);
RETURN(TRUE);
END LIST;
PROCEDURE LOAD(Arg : Strngs):BOOLEAN;
VAR Name,F64,Line : Strings;
a,e,l,i,j:CARDINAL;
Err:INTEGER;
BEGIN
l:=Length(Arg);
IF Arg[0]<>42C THEN RETURN(FALSE); END;
IF Arg[l-1] <> "8" THEN PrintLn("?DEVICE NOT PRESENT ERROR.");
RETURN(TRUE); END;
e := l;
WHILE Arg[e]<>42C DO e := e -1; END;
IF e<2 THEN RETURN(FALSE); END;
Copy(Arg,1,e-1,F64);
Print("Searching for "); Print(F64); CR64;
IF F64[0]="$" THEN F64 := "DIR"; END;
Concat("\1541\",F64,Name);
OpenStream(d1541,Name,READ,Err);
IF Err<>0 THEN PrintLn("?FILE NOT FOUND ERROR.");
CloseStream(d1541,Err);
RETURN(TRUE);
ELSE
BASNEW;
PrintLn("LOADING");
WHILE NOT EOS(d1541) DO
REadString(d1541,Line);
Line[40] := GetTerminator();
CutBlanks(Line,Line);
Store(Line);
END;
CloseStream(d1541,Err);
RETURN(TRUE);
END;
END LOAD;
PROCEDURE RUN(Rest:Strngs):BOOLEAN;
VAR line10 : Strngs;
where : CARDINAL;
BEGIN
line10 := Mem[10];
IF Pos(line10,"TEST",0,where) THEN
DOTEST;
RETURN(TRUE);
END;
IF Pos(line10,"SYS",0,where) THEN
DOSYS;
RETURN(TRUE);
END;
PrintLn("SYNTAX ERROR IN 10");
RETURN(TRUE);
END RUN;
PROCEDURE DOTEST;
VAR I:INTEGER;
BEGIN
FOR I:=1 TO 100 DO WriteInt(I,8); WriteInt(I*I,8); CR64; END;
PrintLn("YEAH,IT WORKS !!");
CR64;
END DOTEST;
PROCEDURE Dprint(S : Strngs);
VAR i :LONGCARD;
BEGIN
PrintLn(S);
FOR i:=1 TO 200000 DO ; END;
END Dprint;
PROCEDURE DOSYS;
BEGIN
EMUL520 := TRUE;
Clr64;
PrintLn("*** C64 - GEM ***");
PrintLn("Installation procedure ...");
Dprint("Memory Bit-compression :");
Dprint("128 K RAM check ok.");
Dprint("256 K RAM check ok.");
Dprint("512 K RAM check ok.");
Dprint("1024 K (1MB) RAM check ok.");
CR64;
Dprint("Clock speed up : 1MHz");
Dprint(" 2MHz");
Dprint(" 3MHz");
Dprint(" 4MHz");
Dprint(" 8MHz");
Dprint(" 16MHz");
Dprint("*** Ram response too slow ***");
Dprint("Clock switched back to 8 MHz");
Dprint("----------------------------");
Dprint("Horizontal video freq. :");
Dprint("doubled.Video shifter-enable:");
Cls(0); Reverse(0);
WriteString("Done.8 MHz clock gated to processor input now");
WriteLn;
WriteString("*** Error : Harddisk simulator cannot be activated ***");
WriteLn;
WriteString(" CBM 1541 drive is (physically) required for this.");
WriteLn;
WriteString(" Hit the SPACE key on your C64 to start the simulated ");
WriteLn;
WriteString(" GEM (C) (TM) Desktop routines "); Wait(" ");
Cls(0);
END DOSYS; (* brrr *)
PROCEDURE BASIC64;
VAR Cmd : Strngs;
BEGIN
IF Length(CmdLine)>0 THEN CutBlanks(CmdLine,Cmd); END;
IF Cmd[0] IN Charset {"0".."9"} THEN
Store(Cmd);
ELSE
IF Length(Cmd) > 0 THEN
Cursor(0);
IF NOT EXEC(Cmd) THEN PrintLn("?SYNTAX ERROR."); END;
PrintLn("READY.");
Cursor(1);
END;
END;
END BASIC64;
PROCEDURE EXEC(VAR S:Strngs):BOOLEAN;
VAR L,Cmd,Rest : Strngs;
Flag : BOOLEAN;
i,a,e : CARDINAL;
BEGIN
L := S;
(* Find end of command *)
IF Length(L)=0 THEN
RETURN(TRUE);
ELSE
WHILE L[0] = ":" DO Delete(L,0,1); END; (* IGNORE ":" *)
e := 0;
WHILE L[e] IN Charset {"A".."Z"} DO e := e + 1; END;
IF e=0 THEN RETURN(FALSE); END;
Copy(L,0,e,Cmd);
Copy(L,e,Length(L)-e,Rest);
CutBlanks(Rest,Rest);
Flag := FALSE;
IF (Compare("LIST",Cmd)=Equal) THEN Flag:=LIST(Rest); END;
IF (Compare("NEW",Cmd)=Equal) THEN Flag:=PBASNEW(Rest); END;
IF (Compare("LOAD",Cmd)=Equal) THEN Flag:=LOAD(Rest); END;
IF (Compare("RUN",Cmd)=Equal) THEN Flag:=RUN(Rest); END;
RETURN(Flag);
END;
END EXEC;
BEGIN
EMUL520 := FALSE;
InitStringModule;
SetDTA(ADR(MyBuf));
Reset64;
REPEAT
C := 377C;
RawScanIn(C,S); IF C=15C THEN CmdLine := Scr[Cy]; END;
OutChr64(C,S);
IF C=15C THEN BASIC64; END;
UNTIL (C=3C) OR EMUL520;
Cursor(0);
END Emulator.